Directorty Opus 5 - Magellan/Opus 5 - Magellan.iso/Extras/LhADir/REXX/LhADir.dopus

Text File | 1996-02-03 | 22KB | 823 lines

/*
  $VER: LhADir.dopus 1.12 (3.2.96)
  Copyright © 1993-1996 by Edmund Vermeulen.
  Placed in the public domain. No restrictions on distribution or usage.

  LhADir.dopus is an ARexx script for Directory Opus that allows you to show
  the contents of LhA archives in a DOpus window and operate on the files and
  directories inside the archive as if it is a normal directory.
*/

signal on syntax    /* intercept syntax errors */
options results        /* need results */
options failat 21    /* external commands are allowed return code 20 */
lf='0a'x        /* ascii code for linefeed */

parse arg command portname . '"' selected '"'
upper command
if portname~=='' then
   address value portname
else
   portname=address()
parse var portname '.' port  /* port number */

busy on            /* busy mouse pointer on */
status 3        /* get active window */
win=result
status 9 win        /* get number of selected entries */
entries=result
checkabort        /* reset abort flag */

if ~show('l','rexxsupport.library') then
   call addlib('rexxsupport.library',0,-30)  /* needed for delay() and showlist() */

call checkconfig
call checklhadir(win)

if selected~=='' then do
   filetype=-1
   entries=1
   end
else
   if entries>0 then
      call getnextone

topline=""
listlha=0
notmove=command~='MOVE'

select
   when command='GETDIR' then
      call dogetdir
   when command='BROWSE' then
      call dogetdir
   when command='PARENT' then
      call doparent
   when command='ROOT' then
      call doroot
   when command='DELETE' then
      call dodelete
   when command='COPY' then
      call docopy
   when command='MOVE' then
      call docopy
   when command='MAKEDIR' then
      call domakedir
   when command='GETSIZES' then
      call dogetsizes
   otherwise do
      async=pos('|'command'|','|READ|ANSIREAD|HEXREAD|')>0
      if entries=0|async|pos('|'command'|','|VERSION|CFX|')>0 then
         n=1
      else
         n=entries
      thisfile=''
      internal=1

      do until n=0
         n=n-1
         if lhadir&entries>0 then do
            if filetype>0 then
               call quitit("Error, directories cannot be viewed.")
            address command 'LhA e -q -x2 -Qo "'patch(lhafile,0)'" T: "'patch(lhasubdir||selected,1)'"'
            if rc>0 then
               call quitit("Error while extracting file.")
            thisfile='"T:'selected'"'
            end

         select  /* internal commands */
            when command='READ' then
               read thisfile
            when command='ANSIREAD' then
               ansiread thisfile
            when command='HEXREAD' then
               hexread thisfile
            when command='SHOW' then
               show thisfile
            when command='PLAY' then
               play thisfile
            when command='LOOPPLAY' then
               loopplay thisfile
            when command='PRINT' then
               print thisfile
            when command='ICONINFO' then
               iconinfo thisfile
            when command='RUN' then
               run thisfile
            otherwise do  /* external commands */
               internal=0
               if ~lhadir&entries>0 then
                  thisfile='"'winpath||selected'"'
               query screenname
               if result=0 then
                  screenname=portname  /* for compatibility */
               else
                  screenname=result

               select
                  when command='VERSION' then
                     call doversion
                  when command='UNDMS' then
                     call doundms
                  when command='CFX' then
                     call docfx
                  when command='MULTIVIEW' then
                     address command 'MultiView' thisfile 'PUBSCREEN' screenname 'FONTNAME' fontname 'FONTSIZE' fontsize
                  when command='AMIGAGUIDE' then
                     address command 'AmigaGuide' thisfile 'PUBSCREEN' screenname
                  when command='VIEWTEK' then
                     address command 'VT >NIL:' thisfile
                  when command='RETINADISPLAY' then
                     address command 'Work:RetinaTools/RetinaDisplay' thisfile
                  when command='FASTVIEW' then
                     address command 'Work:OtherTools/FastView >NIL:' thisfile 'DITHER'
                  otherwise
                     call quitit("Error, LhADir.dopus does not support the command '"command"'.")
                  end
               abort=0
               end
            end

         if internal then
            abort=result~=0
         busy on
         if lhadir&entries>0 then do
            if async then
               call delay(75)  /* wait a bit before deleting */
            delete '"T:'selected'"'
            busy on
            end
         else
            if internal then
               n=0
         if thisfile~=='' then do
            selectfile '"'selected'" 0 1'  /* deselect item */
            if topline=="" then
               topline="OK"
            end
         checkabort
         if result|abort then
            call quitit("Aborted...")
         if n>0 then
            call getnextone
         end
      end
   end

call quitit(topline)  /* finished */


dogetdir:

   if entries>0 then
      if filetype>0 then  /* list a new dir */
         if lhadir then
            lhasubdir=lhasubdir||selected'/'
         else
            winpath=winpath||selected'/'
      else do  /* list an archive file */
         if pos('|'upper(right(selected,4)'|'),'|.LHA|.LZH|.RUN|')=0 then
            call quitit("Error, LhADir.dopus can only list LhA archives.")
         if lhadir then do
            request "This is an archive in an archive."lf"Extract it to 'T:' and then list it?"
            uset=result
            if uset then
               destpath='T:'
            else do
               busy on
               status 13 1-win  /* get window path */
               destpath=result
               if result=='' then
                  call quitit("Aborted...")
               request "Use the current destination window"lf"'"destpath"' instead?"
               if ~result then
                  call quitit("Aborted...")
               end
            busy on
            toptext "Extracting from archive..."
            address command 'LhA e -q -x2 -a -C0 -Qo "'patch(lhafile,0)'" "'destpath'" "'patch(lhasubdir||selected,1)'"'
            if rc>0 then
               call quitit("Error while extracting from archive.")
            if ~uset&command='GETDIR' then
               rescan 1-win
            lhafile=destpath||selected
            end
         else
            lhafile=winpath||selected
         lhadir=1
         lhasubdir=''
         listlha=1
         end
   else  /* rescan current dir */
      if lhadir then do
         status 6 win  /* get number of entries */
         listlha=result>0
         end

   if command='BROWSE' then do
      selectfile '"'selected'" 0 1'
      call swapactive
      end
   if lhadir then do
      call showlhadir
      topline="OK"
      end
   else
      status 13 win set '"'winpath'"'
   return


doparent:

   if lhadir&lhasubdir~=='' then do
      cuthere=lastpos('/',left(lhasubdir,length(lhasubdir)-1))
      lhasubdir=left(lhasubdir,cuthere)
      call showlhadir
      topline="OK"
      end
   else
      parent
   return


doroot:

   if lhadir&lhasubdir~=='' then do
      lhasubdir=''
      call showlhadir
      topline="OK"
      end
   else
      root
   return


dodelete:

   if lhadir then do
      if entries=0 then
         call quitit
      if notmove then do
         if askdelete then do
            status 26 set 'Delete'
            request "Do you really wish to delete selected entries"lf"from archive?"
            if ~result then
               call quitit("Aborted...")
            busy on
            end
         call getall
         end
      call open('actionfile','T:actionfile'port,'w')
      do i=1 to entries
         if type.i>0 then
            wild='/#?'
         else
            wild=''
         call writeln('actionfile','"'patch(lhasubdir||name.i,1)||wild'"')
         removefile '"'name.i'" 0'
         end
      call close('actionfile')
      toptext "Deleting from archive..."
      address command 'LhA d -q -Qp -Qo "'patch(lhafile,0)'" @T:actionfile'port
      if rc>0 then do
         topline="Error while deleting from archive."
         listlha=1
         call showlhadir
         end
      else do
         topline="OK"
         displaydir
         end
      delete 'T:actionfile'port
      delete 'T:LhADir.list'port  /* archive contents has changed */
      busy on
      end
   else do
      if notmove then
         restore
      delete
      end
   return


docopy:

   if entries=0 then
      call quitit
   problem=0
   src=winpath
   s_lhadir=lhadir
   s_lhafile=lhafile
   s_lhasubdir=lhasubdir
   call checklhadir(1-win)

   if s_lhadir then do
      if winpath=='' then do
         errortext="No destination directory selected!"
         toptext errortext
         notify errortext
         call quitit
         end
      if lhadir then
         winpath='T:LhADir'port'/'lhasubdir
      call getall
      call lhaextract
      if lhadir then do
         src=winpath
         call lhaadd
         end
      else
         if problem then
            rescan 1-win
         else do
            do i=1 to entries
               fileinfo '"'name.i'"' '1c'x
               info.i=result
               end
            call swapactive
            do i=1 to entries
               parse var info.i name '1c'x size '1c'x '1c'x type '1c'x '1c'x days '1c'x seconds '1c'x comment '1c'x atts '1c'x
               if type>0 then
                  size=0
               addfile '"'name'"' size type seconds+days*86400 '"'comment'"' atts '0 0'
               end
            displaydir
            call swapactive
            end
      end
   else
      if lhadir then do
         if ~notmove then do
            cuthere=lastpos('/',lhafile)
            if cuthere=0 then
               cuthere=pos(':',lhafile)
            name=substr(lhafile,cuthere+1)
            if left(lhafile,length(src))==src then do
               name=substr(lhafile,length(src)+1)
               parse var name name '/'
               fileinfo '"'name'"' '1c'x
               parse var result '1c'x '1c'x '1c'x '1c'x sel '1c'x
               if sel then do
                  errortext="You can't move an archive into itself!"
                  toptext errortext
                  notify errortext
                  call quitit
                  end
               end
            end
         call getall
         call lhaadd
         end
      else do  /* normal copy or move */
         restore
         if notmove then
            copy
         else
            move
         end

   if (s_lhadir|lhadir)&~notmove&~problem then do
      lhadir=s_lhadir
      lhafile=s_lhafile
      lhasubdir=s_lhasubdir
      checkabort
      if result then
         call quitit("Aborted...")
      call dodelete
      end
   return


domakedir:

   getstring '"Enter directory name or archive name.lha"'
   dirtomake=result
   if rc|dirtomake=='' then
      call quitit
   now=date('i')*86400+time('s')
   if lhadir then do  /* create empty dir in archive */
      call createdirs(dirtomake'/')
      address command 'LhA a -q -e -r -Qo "'patch(lhafile,0)'" T:LhADir'port'/' '"'patch(lhasubdir||dirtomake,1)'"'
      if rc>0 then
         topline="Error while adding to archive."
      else do
         topline="Directory created."
         addfile '"'dirtomake'" 0 1' now '"" ----RWED 0 1'
         end
      delete 'T:LhADir'port
      delete 'T:LhADir.list'port
      busy on
      end
   else do
      if upper(right(dirtomake,4))=='.LHA' then  /* create new archive */
         if open('emptyarchive',winpath||dirtomake,'w') then do
            call writech('emptyarchive','0'x)
            call close('emptyarchive')
            topline="Empty archive created."
            protect '"'winpath||dirtomake'" RWD'
            addfile '"'dirtomake'" 1 -1' now '"" ----RW-D 0 1'
            end
         else
            topline="Error creating archive."
      else do  /* normal makedir */
         restore
         makedir '"'dirtomake'"'
         end
      end
   return


dogetsizes:

   if ~lhadir then
      getsizes
   return


doversion:

   if entries=0 then
      thisfile='REXX:LhADir.dopus'
   toptext "Searching for version string..."
   address command 'Version >T:Version.temp' thisfile 'FILE FULL'
   call open('tempfile','T:Version.temp','r')
   topline=readln('tempfile')
   call close ('tempfile')
   delete 'T:Version.temp'
   return


doundms:

   if entries=0|upper(right(selected,4))~=='.DMS' then
      call quitit("No DMS file selected.")
   drive.1='DF0:'
   drive.0='RAD:'
   status 26 set drive.1
   status 27 set drive.0
   toptext thisfile
   request "Please insert disk and select"lf"destination drive for DMS file."
   dest=result
   busy on
   checkabort
   if result then
      call quitit("Aborted...")

   if drive.dest='RAD:'&~showlist('h','RAD') then
      address command 'Mount RAD:'  /* automatically mount RAD: */

   address command 'Run >T:ProcessNo <NIL: DMS <NIL: >PIPE:dmsout WRITE' thisfile 'TO' drive.dest 'NOTEXT'
   call open('temp','T:ProcessNo','r')
   process=readln('temp')
   parse var process '[CLI ' process ']'
   call close('temp')
   delete 'T:ProcessNo'
   busy on

   nomess=1
   errors=''
   buffer=''
   call open('dmsout','PIPE:dmsout','r')
   do until eof('dmsout')
      buffer=buffer||readch('dmsout',25)
      here=verify(buffer,'0a0d'x,'m')
      if here>0 then do
         line=left(buffer,here-1)
         if nomess&left(line,7)='No Disk' then do
            toptext "Insert disk in" drive.dest
            nomess=0
            end
         if pos('Write-Protected',line)>0 then do
            address command 'Break' process 'C'
            topline="Disk in drive" drive.dest "is write protected."
            beep
            leave
            end
         parse var line ' ' line
         buffer=substr(buffer,here+1)
         if pos('ERROR',upper(line))>0 then do
            errors=errors||lf||line
            beep
            busy on
            end
         if pos('unPacking',line)>0 then do
            track=right(line,2)
            toptext "Unpacking '"selected"'...  Track" track
            checkabort
            if result then do
               address command 'Break' process 'C'
               topline="Aborted..."
               end
            end
         end
      end
   call close('dmsout')
   if errors~=='' then do
      toptext thisfile
      notify "Error Report"||lf||errors
      end
   return


docfx:

   if entries=0 then
      call quitit
   toptext "Examining file..."
   address command 'CFX >T:CFX.temp BeQuiet' thisfile
   call open('tempfile','T:CFX.temp','r')
   topline=readln('tempfile')
   call close ('tempfile')
   delete 'T:CFX.temp'
   return


checklhadir:

   arg checkwin
   status 13 checkwin  /* get window path */
   winpath=result
   test=upper(winpath)
   cuthere=pos('.LHA/',test)
   if cuthere=0 then
      cuthere=pos('.LZH/',test)
   if cuthere=0 then
      cuthere=pos('.RUN/',test)
   lhadir=cuthere>0
   if lhadir then do
      lhafile=left(winpath,cuthere+3)
      lhasubdir=substr(winpath,cuthere+5)
      end
   return


lhaextract:

   status 8 win  /* get number of dirs selected */
   anydirs=result>0
   mustmove=anydirs&s_lhasubdir~==''
   if mustmove then
      destpath=winpath'LhADir'port'/'
   else
      destpath=winpath

   call open('actionfile','T:actionfile'port,'w')
   do i=1 to entries
      if type.i>0 then
         wild='/#?'
      else
         wild=''
      call writeln('actionfile','"'patch(s_lhasubdir||name.i,1)||wild'"')
      end
   call close('actionfile')

   if anydirs then
      lhacmd='x'
   else
      lhacmd='e -x2'
   toptext "Extracting from archive..."
   address command 'LhA' lhacmd '-q -a -C0 -Qo "'patch(s_lhafile,0)'" "'destpath'" @T:actionfile'port
   problem=rc>0
   if problem then
      topline="Error while extracting from archive."
   else do
      topline="OK"
      if notmove then
         none
      end

   if mustmove then do
      do i=1 to entries
         move '"'winpath'LhADir'port'/'s_lhasubdir||name.i'" "'winpath'"'
         end
      delete '"'winpath'LhADir'port'"'
      end
   delete 'T:actionfile'port
   busy on
   return


lhaadd:

   mustcopy=upper(right(src,length(lhasubdir)))~==upper(lhasubdir)
   if mustcopy then do  /* all files must be copied to T: before they can be added */
      homedir='T:LhADir'port'/'
      call createdirs
      end
   else
      homedir=left(src,length(src)-length(lhasubdir))
   call open('actionfile','T:actionfile'port,'w')
   call writeln('actionfile','"'patch(homedir,0)'"')

   if s_lhadir then
      call writeln('actionfile','#?')
   else do
      do i=1 to entries
         call writeln('actionfile','"'patch(lhasubdir||name.i,0)'"')
         if mustcopy then do
            copy '"'src||name.i'" "T:LhADir'port'/'lhasubdir'"'
            busy on
            end
         end
      end
   call close('actionfile')

   if pos('.LZH/',test)>0 then
      method='-0'
   else
      method=''
   toptext "Adding to archive..."
   address command 'LhA r' method '-q -e -r -Qo "'patch(lhafile,0)'" @T:actionfile'port
   problem=rc>0
   if problem then
      topline="Error while adding to archive."
   else do
      topline="OK"
      if notmove then
         none
      end
   delete 'T:actionfile'port
   if mustcopy|s_lhadir then
      delete 'T:LhADir'port
   busy on
   call swapactive
   listlha=1
   call showlhadir
   call swapactive
   return


lhalist:

   address command 'LhA >T:LhADir.list'port 'vv -N -Qw -Qo "'lhafile'"'
   if rc>0 then do
      setwintitle '"<Directory not available>"'
      call quitit("Error while listing archive.")
      end
   return


getnextone:

   getnextselected
   selected=result
   if follow then
      scrolltoshow '"'selected'"'
   fileinfo '"'selected'"' '1c'x
   parse var result '1c'x '1c'x '1c'x filetype '1c'x
   return


getall:

   status 6 win  /* get total number of entries */
   tot=result
   n=1
   do i=1 to tot
      getentry i
      name.n=result
      fileinfo '"'result'"' '1c'x
      parse var result '1c'x '1c'x '1c'x type.n '1c'x sel '1c'x
      if sel then
         n=n+1
      end
   return


createdirs:

   parse arg subdir
   dirstocreate='T:LhADir'port'/'lhasubdir||subdir
   here=0
   do until here=0
      here=pos('/',dirstocreate,here+1)
      if here>0 then
         makedir '"'left(dirstocreate,here-1)'"'
      end
   busy on
   return


swapactive:

   otherwindow
   win=1-win
   return


showlhadir:

   status 13 win set '"'lhafile'/'lhasubdir'"'
   toptext "Listing archive..."  /* toptext obscures error message */
   cuthere=lastpos('/',lhafile)
   if cuthere=0 then
      cuthere=lastpos(':',lhafile)
   setwintitle '"LhADir:' substr(lhafile,cuthere+1)'"'
   call readlist
   return


readlist:

   if ~exists(lhafile) then
      call quitit("Error, archive not found.")
   if listlha|~exists('T:LhADir.list'port) then
      call lhalist
   else do
      call open('tempfile','T:LhADir.list'port,'r')
      nextline=readln('tempfile')
      call close('tempfile')
      parse var nextline 21 whicharc "':"
      if upper(whicharc)~==upper(lhafile) then  /* it's another archive's list */
         call lhalist
      end
   address command 'LhADirList T:LhADir.list'port '"'lhasubdir'"'
   if rc>0 then
      topline="Error while listing archive."
   if ~open('tempfile','T:LhADir.list'port'@','r') then
      call quitit("Error, LhADirList not properly installed.")
   thisline=readln('tempfile')
   do while thisline~=''
      parse var thisline '"' name '" ' size ' ' type ' '  seconds ' ' atts ' ' comment
      addfile '"'name'"' size type seconds '"'comment'"' atts '0 0'
      thisline=readln('tempfile')
      end
   displaydir
   call close('tempfile')
   delete 'T:LhADir.list'port'@'
   busy on
   return


patch:  /* patch filenames containing strange characters */

   parse arg patched,apostrophe
   verstr='*#?|%()[]~'
   if apostrophe then
      verstr=verstr"'"
   pos=1
   do until here=0
      here=verify(substr(patched,pos),verstr,'m')
      if here>0 then do
         pos=pos+here+1
         patched=insert("'",patched,pos-3)
         end
      end
   if left(patched,1)='@' then
      patched='*'patched
   return patched


syntax:

   call quitit("Syntax Error" rc"," errortext(rc) "in line" sigl".")


checkconfig:

   status 26
   okaystring=result
   status 27
   cancelstring=result

   query dirflags
   olddirflags=result
   if olddirflags<0 then  /* bug in DOpus? */
      olddirflags=256+olddirflags
   if bittst(d2c(olddirflags),5) then do
      request "The config setting 'Re-read changed buffers'"lf"must be switched off. Shall I do this for you?"
      if ~result then do
         remember  /* something to restore */
         call quitit("Error, config setting 'Re-read changed buffers' must be switched off.")
         end
      modify dirflags olddirflags-32
      end

   remember                /* remember user settings */
   busy on
   query updateflags
   follow=bittst(d2c(result),1)        /* scroll window to follow operations? */
   modify updateflags 0            /* no progress indicator */
   query deleteflags
   askdelete=bittst(d2c(result),0)    /* ask before deleting? */
   modify deleteflags 8            /* don't ask when deleting internal */
   modify replaceflags 1        /* don't ask when replacing internal */
   modify iconflags 0            /* no icons please */
   query font 2                /* text viewer font */
   parse var result fontname '.font/' fontsize
   return


quitit:

   parse arg topline
   status 26 set okaystring        /* restore okay and */
   status 27 set cancelstring        /* cancel strings */
   restore                /* restore user settings */
   if topline~=="" then
      toptext topline            /* display final message */
   if pos("Error",topline)>0 then
      beep                /* an error occurred */
   busy off                /* busy mouse pointer off */
   exit                    /* stop script here */